##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
## Linking to GEOS 3.11.0, GDAL 3.5.3, PROJ 9.1.0; sf_use_s2() is TRUE
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
testfun <- function() {}
testfun()
## NULL
class(testfun())
## [1] "NULL"
#This function does nothing
testfun <- function() {
print("this function does nothing")
}
testfun()
## [1] "this function does nothing"
#Function does slightly more
testfun <- function(sometext) {
print(sometext)
}
testfun(sometext = "this function does slightly more, but still not much")
## [1] "this function does slightly more, but still not much"
#Practical example
my_age <- function(birthday, output_unit) {
difftime(Sys.time(), birthday, units = output_unit)
}
my_age(birthday = "1996-02-24", output_unit = "days")
## Time difference of 10320.59 days
#Default values
my_age <- function(birthday, output_unit = "days") {
difftime(Sys.time(), birthday, units = output_unit)
}
#If not stated otherwise, our function uses the unit "days"
my_age("1996-02-24")
## Time difference of 10320.59 days
#Overwrite and use hours instead
# We can still overwrite units
my_age("1996-02-24", "hours")
## Time difference of 247694.2 hours
#Function 1: BMI
calculate_bmi <- function(weight, height) {
if (weight <= 0 || height <= 0) {
stop("Weight and height must be positive numbers.")
}
bmi <- weight / (height^2)
return(bmi)
}
#Example
weight <- 79
height <- 1.91
bmi <- calculate_bmi(weight, height)
print(bmi)
## [1] 21.65511
#Function 2: Celsius to Farenheight transformation
celsius_to_fahrenheit <- function(celsius) {
fahrenheit <- celsius * 9/5 + 32
return(fahrenheit)
}
#Example
celsius <- 28
fahrenheit <- celsius_to_fahrenheit(celsius)
print(fahrenheit)
## [1] 82.4
#Function 3: Euclidean Distance
euclidean_distance <- function(x1, y1, x2, y2) {
distance <- sqrt((x2 - x1)^2 + (y2 - y1)^2)
return(distance)
}
# Example
x1 <- 2
y1 <- 3
x2 <- 7
y2 <- 11
distance <- euclidean_distance(x1, y1, x2, y2)
print(distance)
## [1] 9.433981
#Task 2: Prepare Analysis
#Load dataset
data <- read.csv('Data/wildschwein_BE_2056.csv')
#Convert the DatetimeUTC column to Date type
data$DatetimeUTC <- as.POSIXct(data$DatetimeUTC, format="%Y-%m-%dT%H:%M:%SZ", tz="UTC")
#Filter the data for the individuals Rosa and Sabi within the specified date range
filtered_data_sabirosi <- data %>%
filter(TierName %in% c("Rosa", "Sabi") &
DatetimeUTC >= as.POSIXct("2015-04-01", tz="UTC") &
DatetimeUTC <= as.POSIXct("2015-04-15", tz="UTC"))
#Display the filtered data
print(head(filtered_data_sabirosi))
## TierID TierName CollarID DatetimeUTC E N
## 1 002A Sabi 12275 2015-04-01 00:00:11 2570372 1205313
## 2 002A Sabi 12275 2015-04-01 00:15:22 2570309 1205262
## 3 002A Sabi 12275 2015-04-01 00:30:11 2570326 1205248
## 4 002A Sabi 12275 2015-04-01 00:45:16 2570315 1205242
## 5 002A Sabi 12275 2015-04-01 01:00:44 2570323 1205237
## 6 002A Sabi 12275 2015-04-01 01:15:17 2570320 1205247
#Task 3: Create Join Key
#Adjust the time stamps to a common concurrent interval
filtered_data_sabirosi <- filtered_data_sabirosi %>%
mutate(RoundedTime = round_date(DatetimeUTC, "15 minutes"))
#Task 4: Create Join Key
#Split into 1 dataframe for each animal
rosa_data <- filtered_data_sabirosi %>% filter(TierName == "Rosa")
sabi_data <- filtered_data_sabirosi %>% filter(TierName == "Sabi")
#Join by rounded time (date)
joined_data <- full_join(rosa_data, sabi_data, by = "RoundedTime")
#Calculate Euclidean distances between concurrent observations and store values in new column
euclidean_distance <- function(x1, y1, x2, y2) {
distance <- sqrt((x2 - x1)^2 + (y2 - y1)^2)
return(distance)
}
joined_data <- joined_data %>%
mutate(Distance = euclidean_distance(rosa_data$E, rosa_data$N, sabi_data$E, sabi_data$N))
#Use threshold to detemine if animals are close enough
joined_data <- joined_data %>%
mutate(Meet = Distance <= 150)
#Task5: Visualize data
#Prepare data
rosa_points <- joined_data %>%
select(RoundedTime, E.x, N.x, Meet) %>%
rename(E = E.x, N = N.x, Meets = Meet) %>%
mutate(Animal = 'rosa')
sabi_points <- joined_data %>%
select(RoundedTime, E.y, N.y, Meet) %>%
rename(E = E.y, N = N.y, Meets = Meet) %>%
mutate(Animal = 'sabi')
#Combine data for plotting
plot_data <- bind_rows(rosa_points, sabi_points)
#Plotting
ggplot() +
geom_point(data = plot_data, aes(x = E, y = N, color = Animal, alpha = 0.5)) +
geom_point(data = plot_data %>% filter(Meets), aes(x = E, y = N), color = "black", shape = 21, stroke = 1.5, size = 2) +
scale_color_manual(values = c("rosa" = "lightgreen", "sabi" = "lightblue")) +
labs(title = "Movement Patterns from Sabi and Rosa",
subtitle = "With possible meet-up locations",
x = "Easting",
y = "Northing",
color = "Regular Locations",
alpha = "Location Density") +
guides(alpha = "none") +
theme_minimal() +
theme(legend.position = "right")
#Improved visualization
fig <- plot_ly() %>%
add_trace(data = plot_data %>% filter(Animal == 'rosa'),
x = ~E, y = ~N, type = 'scatter', mode = 'markers',
marker = list(color = 'lightgreen', opacity = 0.5),
name = 'Rosa') %>%
add_trace(data = plot_data %>% filter(Animal == 'sabi'),
x = ~E, y = ~N, type = 'scatter', mode = 'markers',
marker = list(color = 'lightblue', opacity = 0.5),
name = 'Sabi') %>%
add_trace(data = plot_data %>% filter(Meets),
x = ~E, y = ~N, type = 'scatter', mode = 'markers',
marker = list(color = 'grey', size = 10, symbol = 'circle-open'),
name = 'Meets') %>%
layout(title = 'Movement Patterns from Sabi and Rosa',
xaxis = list(title = 'Easting'),
yaxis = list(title = 'Northing'),
legend = list(title = list(text = 'Legend')))
fig